home *** CD-ROM | disk | FTP | other *** search
/ Network Support Library / RoseWare - Network Support Library.iso / btrieve / tur5bt.arc / TUR5BTRV.PAS
Pascal/Delphi Source File  |  1988-10-14  |  8KB  |  197 lines
  1. {**************************************************************
  2. TUR5BTRV.PAS  10/14/88  
  3. modification of TUR4BTRV.PAS to turn it into a unit, 
  4. to fix minor bugs & reformat
  5.  
  6. uploaded by David Morgenlender  75206,1070
  7. **************************************************************}
  8.  
  9.  
  10. {$B+}                                       {Boolean complete evaluation on}
  11. {$I+}                                       {I/O checking on}
  12.  
  13. {                                          }
  14. {  Module Name: TUR4BTRV.PAS                              }
  15. {                                          }
  16. {  Description: This is the Btrieve interface for Turbo Pascal (MS-DOS).      }
  17. {        This routine sets up the parameter block expected by          }
  18. {        Btrieve, and issues interrupt 7B.  It should be compiled      }
  19. {        with the $V- switch so that runtime checks will not be          }
  20. {        performed on the variable parameters.                  }
  21. {                                          }
  22. {  Synopsis:    STAT := BTRV (OP, POS.START, DATA.START, DATALEN,          }
  23. {                 KBUF.START, KEY);                  }
  24. {                  where                          }
  25. {            OP is an integer,                      }
  26. {            POS is a 128 byte array,                  }
  27. {            DATA is an untyped parameter for the data buffer,     }
  28. {            DATALEN is the integer length of the data buffer,     }
  29. {            KBUF is the untyped parameter for the key buffer,     }
  30. {            and KEY is an integer.                      }
  31. {                                          }
  32. {  Returns:    Btrieve status code (see Appendix B of the Btrieve Manual).   }
  33. {                                          }
  34. {  Note:    The Btrieve manual states that the 2nd, 3rd, and 5th          }
  35. {        parameters be declared as variant records, with an integer    }
  36. {        type as one of the variants (used only for Btrieve calls),    }
  37. {        as is shown in the example below.  This is supported, but     }
  38. {        the restriction is no longer necessary.  In other words, any  }
  39. {        variable can be sent in those spots as long as the variable   }
  40. {        uses the correct amount of memory so Btrieve does not          }
  41. {        overwrite other variables.                      }
  42. {                                          }
  43. {           var DATA = record case boolean of                  }
  44. {              FALSE: ( START: integer );                  }
  45. {              TRUE:  ( EMPLOYEE_ID: 0..99999;                  }
  46. {                   EMPLOYEE_NAME: packed array[1..50] of char;    }
  47. {                   SALARY: real;                      }
  48. {                   DATA_OF_HIRE: DATE_TYPE );              }
  49. {              end;                              }
  50. {                                          }
  51. {        There should NEVER be any string variables declared in the    }
  52. {        data or key records, because strings store an extra byte for  }
  53. {        the length, which affects the total size of the record.       }
  54. {                                          }
  55. {                                          }
  56.  
  57. UNIT Tur4Btrv;
  58.  
  59. INTERFACE
  60.  
  61. USES
  62.   Dos;
  63.  
  64. FUNCTION BTRV(OP                  : Integer; 
  65.               VAR POS, DATA; 
  66.               VAR DATALEN         : Integer;
  67.               VAR KBUF; 
  68.               KEY                 : Integer)
  69.   : Integer;
  70.   {.pa}
  71.  
  72. {**************************************************************
  73. **************************************************************}
  74.  
  75. IMPLEMENTATION
  76.  
  77.   FUNCTION BTRV(OP                  : Integer;
  78.                 VAR POS, DATA;
  79.                 VAR DATALEN         : Integer;
  80.                 VAR KBUF;
  81.                 KEY                 : Integer)
  82.     : Integer;
  83.  
  84.   CONST
  85.     VAR_ID              = $6176;            {id for variable length records - 'va'}
  86.     BTR_INT             = $7B;
  87.     BTR2_INT            = $2F;
  88.     BTR_OFFSET          = $0033;
  89.     MULTI_FUNCTION      = $AB;
  90.  
  91.     {  ProcId is used for communicating with the Multi Tasking Version of          }
  92.     {  Btrieve. It contains the process id returned from BMulti and should          }
  93.     {  not be changed once it has been set.                       }
  94.     {                                          }
  95.     ProcId : Integer    = 0;                { initialize to no process id }
  96.     MULTI : Boolean     = False;            { set to true if BMulti is loaded }
  97.     VSet : Boolean      = False;            { set to true if we have checked for BMulti }
  98.  
  99.   TYPE
  100.     ADDR32 = RECORD                         {32 bit address}
  101.                OFFSET              : Word;
  102.                SEGMENT             : Word;
  103.              END;
  104.  
  105.     BTR_PARMS = RECORD
  106.                   USER_BUF_ADDR       : ADDR32; {data buffer address}
  107.                   USER_BUF_LEN        : Integer; {data buffer length}
  108.                   USER_CUR_ADDR       : ADDR32; {currency block address}
  109.                   USER_FCB_ADDR       : ADDR32; {file control block address}
  110.                   USER_FUNCTION       : Integer; {Btrieve operation}
  111.                   USER_KEY_ADDR       : ADDR32; {key buffer address}
  112.                   USER_KEY_LENGTH     : Byte; {key buffer length}
  113.                   USER_KEY_NUMBER     : Byte; {key number}
  114.                   USER_STAT_ADDR      : ADDR32; {return status address}
  115.                   XFACE_ID            : Integer; {language interface id}
  116.                 END;
  117.  
  118.   VAR
  119.     STAT                : Integer;          {Btrieve status code}
  120.     XDATA               : BTR_PARMS;        {Btrieve parameter block}
  121.     REGS                : Dos.Registers;    {register structure used on interrrupt call}
  122.     DONE                : Boolean;
  123.  
  124.   BEGIN
  125.     REGS.AX := $3500 + BTR_INT;
  126.     INTR($21, REGS);
  127.     IF (REGS.BX <> BTR_OFFSET) THEN         {make sure Btrieve is installed}
  128.       STAT := 20
  129.     ELSE
  130.       BEGIN
  131.         IF (NOT VSet) THEN                  {if we haven't checked for Multi-User version}
  132.           BEGIN
  133.             REGS.AX := $3000;
  134.             INTR($21, REGS);
  135.             IF ((REGS.AX AND $00FF) >= 3) THEN
  136.               BEGIN
  137.                 VSet := True;
  138.                 REGS.AX := MULTI_FUNCTION * 256;
  139.                 INTR(BTR2_INT, REGS);
  140.                 MULTI := ((REGS.AX AND $00FF) = $004D);
  141.               END
  142.             ELSE
  143.               MULTI := False;
  144.           END;
  145.         {make normal btrieve call}
  146.         WITH XDATA DO
  147.           BEGIN
  148.             USER_BUF_ADDR.SEGMENT := Seg(DATA);
  149.             USER_BUF_ADDR.OFFSET := Ofs(DATA); {set data buffer address}
  150.             USER_BUF_LEN := DATALEN;
  151.             USER_FCB_ADDR.SEGMENT := Seg(POS);
  152.             USER_FCB_ADDR.OFFSET := Ofs(POS); {set FCB address}
  153.             USER_CUR_ADDR.SEGMENT := USER_FCB_ADDR.SEGMENT; {set cur seg}
  154.             USER_CUR_ADDR.OFFSET := USER_FCB_ADDR.OFFSET + 38; {set cur ofs}
  155.             USER_FUNCTION := OP;            {set Btrieve operation code}
  156.             USER_KEY_ADDR.SEGMENT := Seg(KBUF);
  157.             USER_KEY_ADDR.OFFSET := Ofs(KBUF); {set key buffer address}
  158.             USER_KEY_LENGTH := 255;         {assume its large enough}
  159.             USER_KEY_NUMBER := KEY;         {set key number}
  160.             USER_STAT_ADDR.SEGMENT := Seg(STAT);
  161.             USER_STAT_ADDR.OFFSET := Ofs(STAT); {set status address}
  162.             XFACE_ID := VAR_ID;             {set lamguage id}
  163.           END;
  164.  
  165.         REGS.DX := Ofs(XDATA);
  166.         REGS.DS := Seg(XDATA);
  167.  
  168.         IF (NOT MULTI) THEN                 {MultiUser version not installed}
  169.           INTR(BTR_INT, REGS)
  170.         ELSE
  171.           BEGIN
  172.             DONE := False;
  173.             REPEAT
  174.               REGS.BX := ProcId;
  175.               REGS.AX := 1;
  176.               IF (REGS.BX <> 0) THEN
  177.                 REGS.AX := 2;
  178.               REGS.AX := REGS.AX + (MULTI_FUNCTION * 256);
  179.               INTR(BTR2_INT, REGS);
  180.               IF ((REGS.AX AND $00FF) = 0) THEN
  181.                 DONE := True
  182.               ELSE BEGIN
  183.                 REGS.AX := $0200;
  184.                 INTR($7F, REGS);
  185.                 DONE := False;
  186.               END;
  187.             UNTIL (DONE);
  188.             IF (ProcId = 0) THEN
  189.               ProcId := REGS.BX;
  190.           END;
  191.         DATALEN := XDATA.USER_BUF_LEN;
  192.       END;
  193.     BTRV := STAT;
  194.   END;
  195.  
  196. END.
  197.